Vignette MorphoGraphX2R - time serie

Marion Louveaux

2018-05-14

The goal of this vignette is to highlight the power of R and Plotly regarding the visualisation of time series.

Librairies

library(colorRamps)
library(dplyr)
library(plotly)
library(purrr)
library(MorphoGraphX2R)

Data (all meshes from one individual)

Some .ply demonstration data coming from my PhD thesis are attached to this package and used here in the vignette. This dataset is a timelapse recording of the development of a WT shoot apical meristem expressing a membrane marker. I took one 3D stack every 12h and have 5 timepoints in total. Here I load the .ply and cell graph .ply for all the timepoints of this timelapse recording.

ply.dir <- system.file("extdata", "normalMesh/", package = "MorphoGraphX2R")

mesh.all <- map(list.files(ply.dir, recursive = TRUE, full.names = TRUE),
                ~ modified_read.ply(file = .x, ShowSpecimen = FALSE))
#> [1] "Object has 7802 faces and 4180 vertices."
#> [1] "Object has 7689 faces and 4170 vertices."
#> [1] "Object has 6339 faces and 3455 vertices."
#> [1] "Object has 5731 faces and 3137 vertices."
#> [1] "Object has 6147 faces and 3354 vertices."


graph.dir <- system.file("extdata", "cellGraph/", package = "MorphoGraphX2R")

cellGraph.all <- map(list.files(graph.dir, recursive = TRUE, full.names = TRUE), ~modified_read.cellGraph(fileCellGraph = .x, header_max = 30))

Plotly with slider

In plotly, the slider option allows to visualise several graphs linked by a time variable.

meshColors.all <- list(NULL, NULL, NULL, NULL, NULL)

plotlySlider <- function(meshExample,
                     graphExample,
                     meshColors,
                     display,
                     defaultColor = list("#CCCCFF", 0.2),
                     heatmapParam = "GeometryArea"
){
  makeColorScale <- FALSE
  if (display == 'labels'){
    opacity <- 1
    if (is.null(meshColors)){
      meshColors <- meshExample$allColors$Col_label
    }
    if (ncol(meshColors)>1){
      color <- NULL
      for (i in 1:ncol(meshColors)){
        color[i] <-  setdiff(unique(meshColors[,i]), "#000000") #I remove black vertices
      } # to be more general, remove any color shared by two vertices
    }else{
      color <- meshColors
    }
  } else if (display == 'none'){
    color <- rep(defaultColor[[1]], ncol(meshExample$it)) # "#00FFFF"
    opacity <- defaultColor[[2]]
  } else if (display == 'heatmap'){
    if (is.numeric(meshColors) == TRUE && is.null(heatmapParam) == TRUE ){
      makeColorScale <- TRUE
      colorCut <- cut(pull(meshColors), 15,
                      labels =  matlab.like(15)
      )
      color <- as.character(colorCut)
      opacity <- 1
    }else if (is.null(heatmapParam) == FALSE){
      meshColors <- left_join(meshExample$it_label, graphExample$vertices) %>%
        select_(., heatmapParam)
      makeColorScale <- TRUE
      colorCut <- cut(pull(meshColors), 15,
                      labels =  matlab.like(15)
      )
      color <- as.character(colorCut)
      opacity <- 1
    }else{
      warning("Provide continous variable for heatmap or valid heatmap parameter.")
    }
  }
  
  
  trace2 <- list(type="mesh3d",
                 x = meshExample$vb[1,],
                 y = meshExample$vb[2,],
                 z = meshExample$vb[3,],
                 i = meshExample$it[1,]-1, # NB indices start at 0
                 j = meshExample$it[2,]-1,
                 k = meshExample$it[3,]-1,
                 facecolor = color,
                 opacity = opacity,
                 visible = FALSE
  )
  
  
  if (makeColorScale){
    
    trace4 <- list(x = c(100,1,200),
                   y = c(200,1,1),
                   z = c(1,500,3),
                   marker = list(
                     autocolorscale = FALSE,
                     cmax = round(max(meshColors)),#2.5,
                     cmin = round(min(meshColors)),#0,
                     color = c("#0000aa", "#99ff99", "#aa0000"),
                     colorbar = list(
                       x = 1.2,
                       y = 0.5,
                       len = 1,
                       thickness = 15,
                       tickfont = list(size = 12),
                       titlefont = list(size = 20)
                     ),
                     colorscale = purrr::map2(.x = seq(0,1, len=15),
                                              .y = matlab.like(15),
                                              ~ list(.x, .y)),
                     line = list(width = 0),
                     opacity = 0.1,
                     showscale = TRUE,
                     size = 20,
                     symbol = "circle"
                   ),
                   mode = "markers",
                   opacity = 0,
                   type = "scatter3d"
    )
  }else{
    trace4 <- NULL
  }
  
  meshCellcenter <- graphExample$vertices[,c("label","x", "y", "z")]
  
  list(trace2, trace4, meshCellcenter)
  #facecolor: one color per triangle (e.g. length(facecolor) == length(i))
}

all.trace <- pmap(list(meshExample = mesh.all,
                       graphExample = cellGraph.all,
                       meshColors = meshColors.all,
                       display = 'heatmap'),`plotlySlider`)

all.trace[[1]][[1]]$visible = TRUE

layout <- list(
  scene = list(
    xaxis = list(
      backgroundcolor = "rgb(230,230,230)", 
      gridcolor = "rgb(255,255,255)", 
      showbackground = TRUE, 
      zerolinecolor = "rgb(255,255,255"
    ), 
    yaxis = list(
      backgroundcolor = "rgb(230,230,230)", 
      gridcolor = "rgb(255,255,255)", 
      showbackground = TRUE, 
      zerolinecolor = "rgb(255,255,255"
    ), 
    zaxis = list(
      backgroundcolor = "rgb(230,230,230)", 
      gridcolor = "rgb(255,255,255)", 
      showbackground = TRUE, 
      zerolinecolor = "rgb(255,255,255"
    )
  ), 
  title = "My mesh", 
  xaxis = list(title = "m[, 1]"), 
  yaxis = list(title = "m[, 2]")
)

p <- plot_ly()

steps <- list()
for (t in 1:length(all.trace)){
  traceCount <- 0
  p <- add_trace(p, x=all.trace[[t]][[1]]$x,
                 y=all.trace[[t]][[1]]$y,
                 z=all.trace[[t]][[1]]$z,
                 facecolor=all.trace[[t]][[1]]$facecolor,
                 i=all.trace[[t]][[1]]$i,
                 j=all.trace[[t]][[1]]$j,
                 k=all.trace[[t]][[1]]$k,
                 type=all.trace[[t]][[1]]$type,
                 visible = all.trace[[t]][[1]]$visible,
                 hoverinfo = 'none')
  traceCount <- 1
  
  if (!is.null(all.trace[[t]][[2]])){
    traceCount <- traceCount+1
    p <- add_trace(p,
                   x = all.trace[[t]][[3]]$x,
                   y = all.trace[[t]][[3]]$y,
                   z = all.trace[[t]][[3]]$z,
                   text = as.character(all.trace[[t]][[3]]$label),
                   hoverinfo = 'text',
                   marker = all.trace[[t]][[2]]$marker,
                   mode = all.trace[[t]][[2]]$mode,
                   opacity = all.trace[[t]][[2]]$opacity,
                   type = all.trace[[t]][[2]]$type,
                   showlegend = FALSE#,
                   # hoverinfo = 'none'
    )
  }
  if (!is.null(all.trace[[t]][[3]])){ # show cell center
    traceCount <- traceCount+1
    p <- add_trace(p, x = all.trace[[t]][[3]]$x,
                   y = all.trace[[t]][[3]]$y,
                   z = all.trace[[t]][[3]]$z,
                   text = as.character(all.trace[[t]][[3]]$label),
                   hoverinfo = 'text',
                   type = "scatter3d",
                   mode = "markers",
                   marker=list(color = 'rgb(255, 255, 255)',
                               size = 10),
                   opacity = 0,
                   showlegend = FALSE
    )
  }
  
  p <- layout(p, scene=layout$scene, title=layout$title, xaxis=layout$xaxis, yaxis=layout$yaxis)
  
  if (traceCount == 1){
    step <- list(args = list('visible', rep(FALSE, length(all.trace))),
                 method = 'restyle')
    step$args[[2]][t] = TRUE 
  }else if (traceCount == 2){ # slider takes in account all existing traces
    step <- list(args = list('visible', rep(FALSE, length(all.trace)*2)),
                 method = 'restyle')
    k <- t + (t-1)
    step$args[[2]][k] = TRUE  
    step$args[[2]][k+1] = TRUE
  }else if (traceCount == 3){
    step <- list(args = list('visible', rep(FALSE, length(all.trace)*3)),
                 method = 'restyle')
    increment <- seq(0, (length(all.trace)-1)*2, 2)
    k <- t + increment[t]
    step$args[[2]][k] = TRUE  
    step$args[[2]][k+1] = TRUE
    step$args[[2]][k+2] = TRUE
  }
  
  steps[[t]] = step 
}


p <- p %>%
  layout(sliders = list(list(active = 3,
                             currentvalue = list(prefix = "Frame: "),
                             steps = steps)))
p